SPACE 2/SPACE - Library 2 - Volume 1.iso/games/65/pascal/whereis.pas

Pascal/Delphi Source File | 1986-10-16 | 12.0 KB | 378 lines

{===========================================================================

                               WHEREIS.TOS

        Copyright (c) 1986 by Keith Ledbetter and Orion Micro Systems

            To be given away and used by anyone who wants it!


  Note:  If executing this module from the desktop, you should still name
         it .TOS, not .TTP.  If no parameters are present on the command
         line, the program assumes that it was executed from the desktop
         and will prompt you for the search mask, and will also prompt you
         to 'press return' after the command is executed (so you won't
         flash back to gem before your eyes get focused!).

 ----------------------------------------------------------------------------

  Program WhereIS: searches all subdirectories and displays any filename
                   that matches the given filemask.  If no drive is given,
                   then the search occurs on the default drive.  If no
                   subdirectory is given, then the search begins with the
                   current default directory and goes downward.

  Program Usage:  Is really written for a "command shell" environment, but
                  can be executed from the desktop if given an extender
                  of .TOS  (see above).  Has been tested extensively
                  (1 day.....[just kidding!!]) under DOS-Shell and GEM.

  Program Notes:  WhereIS will build a table of all of the subdirectories
                  on the disk from the current (or specified) path WITHOUT
                  doing recursive-type calls.  This may be a tad bit
                  slower, but it prevents a few "uglies" from popping up
                  such as stack overflow, etc.  Once all of the path names
                  are built into the table, WhereIS simply goes back thru
                  the table and reads the directory of each path looking
                  for matches on the user's input mask.


  Some examples:
  --------------

  whereis *.pas          will show all files with an extender of .PAS on the
                         default drive, beginning the search with the default
                         subdirectory.

  whereis \*.pas         will again show all files that have an extender of
                         .PAS, but the search will begin at the ROOT (main)
                         directory.  In other words, it will show any .PAS
                         file on the ENTIRE disk.

  whereis b:\ab*.*       will show any file on diskette b: that begins with the
                         letters "ab".

  whereis \whereis.pas   will show any file on the default drive that has the
                         name WHEREIS.PAS.

  whereis c:\dir1\*.txt  will show any file on drive c, beginning in
                         subdirectory \dir1\, that has an extender of .txt.


    Now, who says you have to write everything useful in C ??  (heheh)

 ===========================================================================}


 {$C-,D-,P-,R-,T-}                  { compiler directives }


Program WhereIs;

 Const Copyright =
'  WHEREIS v1.0 (FreeWare)  (c) 1986 by Keith Ledbetter / Orion Micro Systems';

 Type  Fmask = Packed Array [1..14] of Char;
       TPath = Packed Array [1..80] of Char;
       Str12 = String [12];

       Ftrec = Packed Record
                  Dirnum: Byte;          { directory number          }
                  Parent: Byte;          { parent directory's number }
                  Name  : Str12;         { subdirectory name         }
               End;

       Dtrec = Packed Record
                  No_touch : Packed Array [0..19] of Byte;
                  No_touch2: Byte;
                  Attr     : Byte;
                  T_Stamp  : Integer;
                  D_Stamp  : Integer;
                  Filesize : Long_Integer;
                  Name     : Fmask;
               End;


  Var Inrec       : Dtrec;
      Table       : Packed Array [1..255] of Ftrec;  { hold 255 directories }
      CurPath     : TPath;
      CurIdx      : Byte;                 { index into the table       }
      CurParent   : Byte;                 { current parent path        }
      X           : Integer;              { marks the spot...          }
      Def_Drive   : String [80];          { where we are starting from }
      Root_Path   : String [80];          { used as a work field       }
      Search_Mask : String [80];          { what user wants us to find }
      Temp        : String [80];
      Pname       : Str12;
      From_GEM    : Boolean;              { true if no parameters      }


 {================================

    Some various GemDOS calls...

  ================================}

 Function Cur_Drive : Integer;
    GemDOS( $19 ) ;

 Procedure Set_DTA (Var Buffer: Dtrec) ;
    GemDOS( $1a ) ;

 Function Get_First (Var Path: TPath; Attr: Integer): Integer;
    GemDOS( $4e ) ;

 Function Get_Next: Integer;
    GemDOS( $4f ) ;



 {====================================================

    Build a string variable from the DTA buffer area

  ====================================================}

 Procedure Make_Fname (Var S: Str12);

  Var X: Integer;

   Begin
     X := 1;
     While (X <= 14) and (Inrec.Name [X] <> #0) do
       begin
         S [X] := Inrec.Name [X];
         X := X + 1;
       end;
     S [0] := Chr (X - 1);
   End;



 {====================================================

    Build the FULL path name of an entry from the
    table by searching backwards in the table.

  ====================================================}

 Procedure Build_Mask (Pos: Integer);

 Var X: Integer;
     H: Array [1..25] of Byte;          { holds indexes of paths      }
     Z: Integer;

  Begin
    Z := 0;                             { we must loop upwards in the }
    Repeat                              { filename table, saving the  }
      Z := Z + 1;                       { parents of this directory   }
      H [Z] := Table [Pos].Dirnum;      { until we reach the root     }
      Pos := Table [Pos].Parent;        { directory.                  }
    Until Pos = 0;

    Root_Path := Def_Drive;             { now go thru and concat them }
    Repeat
      Root_Path := Concat (Root_Path, Table [H[Z]].Name, '\');
      Z := Z - 1;
    Until Z < 1;
  End;




 {====================================================

    This is the real workhorse.  It builds the table
    entries of each subdirectory on the disk.

  ====================================================}

 Procedure Build_Subdir_Table;

  Var I, Tot : Integer;

  Begin
     CurIdx := 1;
     CurParent := 0;

     Tot := 0;
     Set_DTA (Inrec);

     While Tot < CurIdx do
       Begin
         CurParent := Tot;
         If Tot = 0 then
           Root_Path := Def_Drive
         Else
           Build_Mask (Tot);
         Temp := Concat (Root_Path, '*.*');
         For I := 1 to Length (Temp) do
           CurPath [I] := Temp [I] ;
         CurPath [Length (Temp) + 1] := #0;
         If Get_first (CurPath, $10 ) >= 0 Then
           Repeat
             With Inrec do
               Begin
                 If (Attr = $10) and (Name [1] <> '.') then
                   Begin
                     Table [CurIdx].Dirnum := CurIdx;
                     Table [CurIdx].Parent := CurParent;
                     Make_Fname (Table [CurIdx].Name);
                     CurIdx := CurIdx + 1;
                   End;
               End;
           Until Get_Next < 0 ;
           Tot := Tot + 1;
       End;
  End;



 {====================================================

    Go through the table and search each subdirectory
    for the requested filename.  If found, display it.

  ====================================================}

 Procedure Find_File;

  Var Tot, C, Z, I: Integer;
      First: Boolean;

  Begin
    Tot := 0;
    Set_DTA (Inrec);
    First := True;

    For Z := 0 to CurIdx - 1 do                   { do entire table    }
      Begin
        If Z = 0 then
          Root_Path := Def_Drive
        Else
          Build_Mask (Z);
        Temp := Concat (Root_Path, Search_Mask);
        For I := 1 to Length (Temp) do
          CurPath [I] := Temp [I] ;
        CurPath [Length (Temp) + 1] := #0;
        If Get_first (CurPath, 0) >= 0 Then       { found one!  }
          Repeat
            Make_Fname (Pname);
            If First then
              Begin
                Write (#13,#27,'K');
                First := False;
              End;
            Writeln ('     ',Root_Path, Pname);
            Tot := Tot + 1;
          Until Get_Next < 0 ;                    { get next one }
      End;

    If Tot = 0 then
      Writeln (#13,#27,'K',' No matches found.')
    Else
      Begin
        Writeln;
        If Tot = 1 then
          Writeln (' 1 match found.')
        Else
          Writeln (' ',Tot,' matches found.');
      End;
 End;




 {==================================

    Throw out a little help menu..

  ==================================}

 Procedure Help_Em_Out;

 Begin
  Writeln (
  '  Usage:  WHEREIS [a:\dir\]filemask.ext');
  Writeln;
  Writeln(
  '   Desc:  WHEREIS will search downward from either the current drive/path');
  Writeln(
  '          or the specified drive/path looking for matches on the filename');
  Writeln(
  '          that you enter.  All matches will be displayed with their full');
  Writeln(
  '          pathname.  Primarily for hard disk users, it''s great for times');
  Writeln(
  '          you can''t quite remember where you put that file!');
  Writeln(
  '          Full wildcards are allowed in the search specifier.');
 End;



 {===============================================

    Strip out the starting drive/path and the
    search mask from the user's input line.

  ===============================================}

 Procedure Process_Cmd_Line;

  Var X: Integer;

  Begin
    Def_Drive := Search_Mask;                 { plop it into defdrive  }
    X := Length (Search_Mask);                { now, go backwards in   }
    While (Search_Mask [X] <> '\') and        {  search_mask until we  }
          (Search_Mask [X] <> ':') and        {  find the end of the   }
          (X > 0) do                          {  path (if there is one)}
        X := X - 1;
    Def_Drive [0] := Chr (X);                 { set length byte        }
    Delete (Search_Mask,1,Length(Def_Drive)); { remove path from search}
    If Length (Search_Mask) = 0 then          { if no filename, do all }
      Search_Mask := '*.*';                   {  (that'll teach em!)   }
  End;




 {===============================

     Main Control of WHEREIS

  ===============================}

 Begin

    Writeln;                            { our moment in the sun... }
    Writeln (Copyright);
    Writeln;

    From_GEM := False;                  { default to command line }

    Cmd_GetArg (1, Search_Mask);        { get filemask they want }

    If Length (Search_Mask) = 0 then    { nothing entered, so give }
      Begin                             { them the help screen and }
        Help_Em_Out;                    { prompt/get the search    }
        From_GEM := True;               { mask.                    }
        Writeln;
        Write ('Search Mask => ');
        Readln (Search_Mask);
        Writeln;
      End;

    Process_Cmd_Line;                   { strip out parms          }
    Write (' Please Wait...');          { give us a second or two  }
    Build_Subdir_Table;                 { generate the table       }
    Find_File;                          { look for matches         }
    If From_GEM then                    { if from GEM, let them    }
      Begin                             { hit return.              }
        Writeln;
        Write ('Press RETURN...');
        Readln (Search_Mask);
      End;
 End.